Delphi Developer's Kit 1996/Delphi Developer's Kit 1996.iso/power/lingua/lingua.pas

Pascal/Delphi Source File | 1995-12-22 | 24KB | 826 lines

unit Lingua;
(***************************************************************************)
(*                                                                         *)
(*   #####    #####     #####   #####    #####    ####    ######  #######  *)
(*  #        #     #   #          #     #        #    #   #          #     *)
(*  #        #     #   #  ###     #      ####    #    #   ###        #     *)
(*  #        #     #   #    #     #          #   #    #   #          #     *)
(*   #####    #####     #####   #####   #####     ####    #          #     *)
(*                                                                         *)
(***************************************************************************)
{
 (c) 1995 Cogisoft
 This component is FREE distribution. Use it for your own utilization.
 But you can't sell an application, using this component, without the
 authorization of Cogisoft.

 COGISOFT,H⌠tel de MΘziΦres,19 rue Michel Le Comte,75003 PARIS,FRANCE
 Tel:[phone], FAX:[phone]

 NO CODING !!!
 Jerome VOLLET, CompuServe : 100560,3342
}
interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Grids, Outline, DB, DBTables, DsgnIntf, DBGrids,
  TypInfo, StdCtrls;

const
    CM_REFRESHTRANSLATION = CM_BASE+1000;
    CM_LINGUACREATED = CM_BASE+1001;

type
  TCallbackUpdateProperty = procedure( var Value : string ) of object;
    TCallbackScanProperties = procedure( Component : TComponent; PropInfo : PPropInfo ) of object;

  TLingua = class(TComponent)
  private
    { Private declarations }
  protected
    { Protected declarations }
        CallbackUpdateProperty : TCallbackUpdateProperty;
        CallbackScanProperties : TCallbackScanProperties;
        FCheck : string;
        FTest : Boolean;
        FOldCookie : string;
    FCookie : string;
    FDatabaseName : TFileName;
        FfmNewKeyword : TForm;
    FLanguage : string;
    FLang_Id : Integer;
    FListComponent : TList;
    FListProperties : TList;
    FNewWordPrompt : boolean;
        FTableLangList : TTable;
        FTableLangWord : TTable;
        FTableLang : TTable;
        FTranslating : Boolean;
      FHandle : HWnd;
        procedure AddComponents;
    function InternalGetWord( Word_Name : string ) : string;
        procedure InternalTranslateProperty( Component : TComponent; PropInfo : PPropInfo );
        procedure UpdateStrProperty( Component : TComponent; PropInfo : PPropInfo );
        procedure ScanProperties( Component : TComponent; TypeKinds: TTypeKinds );
        procedure TranslatePropertyCallback( var Value : string );
        procedure AddCookie2PropertyCallback( var Value : string );
        procedure InsertPropertyCallback( Component : TComponent; PropInfo : PPropInfo );
        procedure UpdateCookieCallback( var Value : string );

        procedure Notification( AComponent : TComponent; Operation : TOperation ); override;
    procedure RefreshTranslation;
        procedure SetCheck( Value : string );
        procedure SetCookie( Value : string );
    procedure SetDatabaseName(const Value: TFileName);
    procedure SetLanguage( Value : string );
        procedure WndProc(var Msg : TMessage);
  public
    { Public declarations }
        constructor Create( AOwner : TComponent ); override;
    destructor Destroy; override;
        procedure InsertNewLanguage( Lang_Name : string );
        procedure InsertNewWord( Word_Name, Word_Trans : string );
    function EditNewWord( Word_Name : string ):Boolean;
        function EditNewLanguage:Boolean;
        procedure EditUpdateCookie;
    function GetWordWithCookie( Word_Name : string ) : string;
    function GetWord( Word_Name : string ) : string;
        procedure AddCookie2Property( Component : TComponent; PropertyName : string );
        procedure TranslateProperty( Component : TComponent; PropertyName : string );
    procedure TranslateComponent( Component : TComponent );
        procedure TranslateForm( Form : TForm );
    procedure Translate;

        property Handle : HWnd read FHandle;
        property TableLangList : TTable read FTableLangList;
  published
    { Published declarations }
    property Check : string read FCheck write SetCheck;
        property Cookie : string read FCookie write SetCookie;
    property DatabaseName : TFileName read FDatabaseName write SetDatabaseName;
    property Language : string read FLanguage write SetLanguage;
    property NewWordPrompt : Boolean read FNewWordPrompt write FNewWordPrompt;
  end;

    TPropertyItem = class
  public
      Component : TComponent;
    PropertyName : string;
    PropertyValue : string;
      constructor Create( c : TComponent; pn, pv : string );
  end;

procedure Register;

implementation

uses DBConsts, Newkwd, NewLang, UpCookie;

constructor TLingua.Create( AOwner : TComponent );
begin
  FListComponent := TList.Create;
  FHandle := AllocateHWnd(WndProc);
  PostMessage( Handle, CM_LINGUACREATED, 0, 0 );
  inherited Create( AOwner );
    FTest := False;
    FLang_Id := 0;
  FLanguage := '';
  FDatabaseName := '';
    FTableLangList := TTable.Create( TComponent( Self ) );
    FTableLangList.TableName := 'LANGLIST';
    FTableLangWord := TTable.Create( TComponent( Self ) );
    FTableLangWord.TableName := 'LANGWORD';
    FTableLang := TTable.Create( TComponent( Self ) );
    FTableLang.TableName := 'LANG';
  Cookie := '##';
  NewWordPrompt := True;
  Check := '';
  FfmNewKeyWord := nil;
    FTranslating := False;
end;

destructor TLingua.Destroy;
begin
  DeallocateHWnd(FHandle);
    if FTableLangList.Active then FTableLang.Close;
    if FTableLangWord.Active then FTableLang.Close;
    if FTableLang.Active then FTableLang.Close;
  FListComponent.Free;
  inherited Destroy;
    if Assigned( FfmNewKeyword ) then FfmNewKeyword.Free;
end;

procedure TLingua.AddComponents;
var
    i    : Integer;
  Form : TForm;
begin
    Form := GetParentForm( Self.Owner as TControl );
    if Form = nil then
    raise Exception.Create( 'Form nil' );
     FListComponent.Add( Form );
    for i:=0 to Form.ComponentCount-1 do
    begin
      FListComponent.Add( Form.Components[ i ] );
  end;
  if not FTranslating then
         PostMessage( Handle, CM_REFRESHTRANSLATION, 0, 0 );
end;

procedure TLingua.WndProc(var Msg: TMessage);
begin
  with Msg do
        case Msg of
        CM_LINGUACREATED:
        if not (csDesigning in ComponentState) then
        begin
                    AddComponents;
          Exit;
          try
            Translate;
          except
              Application.HandleException( Self );
          end;
        end;
        CM_REFRESHTRANSLATION:
          if not FTranslating then
            begin
          try
                RefreshTranslation;
              except
                Application.HandleException(Self);
              end
          end
    else
      Result := DefWindowProc(Handle, Msg, wParam, lParam);
    end;
end;

procedure TLingua.Notification( AComponent : TComponent; Operation : TOperation );
begin
  inherited Notification( AComponent, Operation );
  case Operation of
    opInsert:
    begin
        if not (csDesigning in ComponentState) then
          FListComponent.Add( AComponent );
      if not FTranslating then
          PostMessage( Handle, CM_REFRESHTRANSLATION, 0, 0 );
    end;
    opRemove:
      begin
      end;
  end;
end;

procedure TLingua.RefreshTranslation;
var
    i : integer;
begin
    if FlistComponent.Count = 0 then Exit;
  for i:=0 to FListComponent.Count-1 do
      TranslateComponent( TComponent( FListComponent[ i ] ) );
  FListComponent.Clear;
end;

procedure TLingua.SetCheck( Value : string );
begin
    FCheck := 'Click on ...';
end;

procedure TLingua.UpdateCookieCallback( var Value : string );
begin
  if         (length( Value )>length( FOldCookie ))
      and (CompareText( FOldCookie, Copy( Value, 1, length( FOldCookie ) ))=0) then
        Value := Cookie+Copy( Value, Length(FOldCookie)+1, Length(Value)-length( FOldCookie ));
end;

procedure TLingua.SetCookie( Value : string );
var
    Form : TForm;
  i : Integer;
begin
    if Value = FCookie then Exit;
    FOldCookie := FCookie;
  FCookie := Value;
  if FOldCookie = '' then Exit;
    Form := GetParentForm( Self.Owner as TControl );
  if Form = nil then Exit;
    CallbackScanProperties := UpdateStrProperty;
    CallbackUpdateProperty := UpdateCookieCallback;
    try
        ScanProperties( Form, [tkString] );
        for i:=0 to Form.ComponentCount-1 do
        if not (Form.Components[ i ] is TLingua) then
              ScanProperties( Form.Components[ i ], [tkString] );
    finally
      CallbackScanProperties := nil;
      CallbackUpdateProperty := nil;
  end;
end;

procedure TLingua.SetDatabaseName(const Value: TFileName);
begin
    try
    FTableLangList.Close;
    FTableLangWord.Close;
    FTableLang.Close;
    FTableLangList.DatabaseName := Value;
    FTableLangList.IndexName := 'Lang_Name';
    FTableLangList.Open;
        FTableLangList.First;
    FTableLangWord.DatabaseName := Value;
    FTableLangWord.IndexName := 'Word_Name';
    FTableLangWord.Open;
    FTableLang.DatabaseName := Value;
    FTableLang.Open;
        if FtableLangList.RecordCount = 0 then
            EditNewLanguage;
        if FTableLangList.RecordCount > 0 then
            Language := FTableLangList.FieldByName( 'Lang_Name' ).asString;
    except on E:EDatabaseError do
     begin
        ShowMessage(  'You need to choose the alias wich points on'+#13#10+
                                'tables LANGLIST, LANGWORD and LANG.'+#13#10+#13#10+
                  'If this alias does not exist, you need to create it !!!' );
    exit;
  end;
  end;
  FDatabaseName := Value;
end;

procedure TLingua.SetLanguage( Value : string );
begin
    FTableLangList.SetKey;
  FTableLangList.FieldByName( 'Lang_Name' ).asString := Value;
  if not FTableLangList.GotoKey then
    raise Exception.Create( 'Can''t locate : '+Value );
    FLang_Id := FTableLangList.FieldByName( 'Lang_Id' ).asInteger;
  FLanguage := Value;

    if Assigned( FfmNewKeyword ) then FfmNewKeyword.Free;
     FfmNewKeyword := TfmNewKeyword.Create( nil );
     TranslateForm( FfmNewKeyword );
end;

function TLingua.GetWordWithCookie( Word_Name : string ) : string;
begin
    Result := '';
  if (length( Word_Name )>length( Cookie )) and (CompareText( Cookie, Copy( Word_Name, 1, length( Cookie ) ))=0) then
    begin
      try
      Result := GetWord( Copy( Word_Name, length(Cookie)+1, length(Word_Name)-length(Cookie) ) );
    finally
    end
  end else
      raise Exception.Create( 'No cookie found' );
end;

function TLingua.InternalGetWord( Word_Name : string ) : string;
var
    Word_Id :    Integer;
begin
    Result := '';
    FTableLangWord.SetKey;
  FTableLangWord.FieldByName( 'Word_Name' ).asString := Word_Name;
  if not FTableLangWord.GotoKey then
    raise Exception.Create( 'Can''t locate : '+Word_Name );
    Word_Id := FTableLangWord.FieldByName( 'Word_Id' ).asInteger;
    FTableLang.SetKey;
  FTableLang.FieldByName( 'Word_Id' ).asInteger := Word_Id;
  FTableLang.FieldByName( 'Lang_Id' ).asInteger := FLang_Id;
    if not FTableLang.GotoKey then
    raise Exception.Create( 'Can''t locate word in table LANG' );
    Result := FTableLang.FieldByName( 'Word_Trans' ).asString;
end;

function TLingua.GetWord( Word_Name : string ) : string;
begin
    Result := '';
    try
      Result := InternalGetWord( Word_Name );
  except
    if NewWordPrompt then
    begin
      try
        if EditNewWord( Word_Name ) then
          Result := GetWord( Word_Name )
        else
          Result := Word_Name;
      finally
      end;
    end else
        Result := Word_Name;
  end;
end;

procedure TLingua.UpdateStrProperty( Component : TComponent; PropInfo : PPropInfo );
var
    OldValue, Value : string;
begin
  Value := GetStrProp( Component, PropInfo );
    OldValue := Value;
    if Assigned( CallbackUpdateProperty ) then
      CallbackUpdateProperty( Value );
  if not FTest and (Value <> OldValue) then SetStrProp( Component, PropInfo, Value );
end;

procedure TLingua.InternalTranslateProperty( Component : TComponent; PropInfo : PPropInfo );
begin
    if Language = '' then Exit;
    CallbackUpdateProperty := TranslatePropertyCallback;
    UpdateStrProperty( Component, PropInfo );
    CallbackUpdateProperty := nil;
end;

procedure TLingua.TranslateProperty( Component : TComponent; PropertyName : string );
var
  PropInfo : PPropInfo;
begin
    if Language = '' then Exit;
  PropInfo := GetPropInfo( Component.ClassInfo, PropertyName );
  if PropInfo = nil then Exit;
  if PropInfo^.PropType^.Kind = tkString then
  begin
        CallbackUpdateProperty := TranslatePropertyCallback;
        UpdateStrProperty( Component, PropInfo );
        CallbackUpdateProperty := nil;
  end;
end;

procedure TLingua.AddCookie2Property( Component : TComponent; PropertyName : string );
var
  PropInfo : PPropInfo;
begin
  PropInfo := GetPropInfo( Component.ClassInfo, PropertyName );
  if PropInfo = nil then Exit;
  if PropInfo^.PropType^.Kind = tkString then
  begin
        CallbackUpdateProperty := AddCookie2PropertyCallback;
        UpdateStrProperty( Component, PropInfo );
        CallbackUpdateProperty := nil;
  end;
end;

procedure TLingua.TranslatePropertyCallback( var Value : string );
var
    Word_Name : string;
begin
  if (length( Value )>length( Cookie )) and (CompareText( Cookie, Copy( Value, 1, length( Cookie ) ))=0) then
  begin
    Word_Name := Copy( Value, length(Cookie)+1, length(Value)-length(Cookie) );
    Value := GetWord( Word_Name );
  end;
end;

procedure TLingua.AddCookie2PropertyCallback( var Value : string );
var
    Word_Name : string;
begin
  if         (length( Value )>length( Cookie ))
      and (CompareText( Cookie, Copy( Value, 1, length( Cookie ) ))=0) then
    { Cookie already present }
      Exit;
  Value := Cookie+Value;
end;

procedure TLingua.ScanProperties( Component : TComponent; TypeKinds: TTypeKinds );
var
    j : Integer;
  FCount, FSize : integer;
  FList : PPropList;
begin
  FCount := GetPropList(Component.ClassInfo, TypeKinds, nil);
  FSize := FCount * SizeOf(Pointer);
  GetMem(FList, FSize);
  GetPropList(Component.ClassInfo, TypeKinds, FList);

  for j:=0 to FCount-1 do
  begin
        if Assigned ( CallbackScanProperties ) then
        CallbackScanProperties( Component, FList^[ j ] );
  end;
  FreeMem( FList, FSize );
end;

procedure TLingua.TranslateComponent( Component : TComponent );
begin
    if Language = '' then Exit;
    CallbackScanProperties := InternalTranslateProperty;
    ScanProperties( Component, [ tkString ] );
    CallbackScanProperties := nil;
end;


procedure TLingua.TranslateForm( Form : TForm );
var
    i    : Integer;
  Component : TComponent;
begin
    if Language = '' then Exit;
    TranslateComponent( Form );
    for i:=0 to Form.ComponentCount-1 do
    begin
      Component := Form.Components[ i ];
    TranslateComponent( Component );
  end;
end;

procedure TLingua.Translate;
var
    Form     : TForm;
begin
    if Language = '' then Exit;
    Form := GetParentForm( Self.Owner as TControl );
    if Form = nil then
    raise Exception.Create( 'Form nil' );
  TranslateForm( Form );
end;

procedure TLingua.InsertNewLanguage( Lang_Name : string );

  procedure InsertLangName( Lang_Name : string );
  begin
        FTableLangList.Insert;
    FTableLangList.FieldByName( 'Lang_Name' ).AsString := Lang_Name;
        FTableLangList.Post;
  end;

begin
    { look for an already existing language }
  FTableLangList.SetKey;
  FTableLangList.FieldByName( 'Lang_Name' ).AsString := Lang_Name;
  if not FTableLangList.GotoKey then
  begin
        InsertLangName( Lang_Name );
    end else begin
      raise Exception.Create( 'Language '+Lang_Name+' already exist !!!' );
    end;
end;

procedure TLingua.InsertNewWord( Word_Name, Word_Trans : string );
var
    Word_Id : LongInt;

  procedure InsertWordName( Word_Name : string );
  begin
        FTableLangWord.Insert;
    FTableLangWord.FieldByName( 'Word_Name' ).AsString := Word_Name;
        FTableLangWord.Post;
    Word_Id := FTableLangWord.FieldByName( 'Word_Id' ).AsInteger;
  end;

  procedure InsertWordTrans( Word_Id, Lang_Id : LongInt; Word_Trans : string );
  begin
        FTableLang.Insert;
    FTableLang.FieldByName( 'Word_Id' ).AsInteger := Word_Id;
    FTableLang.FieldByName( 'Lang_Id' ).AsInteger := Lang_Id;
    FTableLang.FieldByName( 'Word_Trans' ).AsString := Word_Trans;
        FTableLang.Post;
  end;

begin
    { look for an already existing keyword }
  FTableLangWord.SetKey;
  FTableLangWord.FieldByName( 'Word_Name' ).asString := Word_Name;
  if not FTableLangWord.GotoKey then
  begin
        InsertWordName( Word_Name );
    InsertWordTrans( Word_Id, FLang_Id, Word_Trans );
    end else begin
      Word_Id := FTableLangWord.FieldByName( 'Word_Id' ).asInteger;
      FTableLang.SetKey;
      FTableLang.FieldByName( 'Word_Id' ).asInteger := Word_Id;
      FTableLang.FieldByName( 'Lang_Id' ).asInteger := FLang_Id;
      if not FTableLang.GotoKey then
    begin
            InsertWordTrans( Word_Id, FLang_Id, Word_Trans );
    end else begin
        FTableLang.Edit;
      FTableLang.FieldByName( 'Word_Trans' ).asString := Word_Trans;
      FTableLang.Post;
    end;
    end;
end;

function TLingua.EditNewWord( Word_Name : string ):Boolean;
begin
    Result := False;
    if FTranslating then Exit;
    FTranslating := True;
  try
        with FfmNewKeyword as TfmNewKeyword do
    begin
        EdLanguage.Text := Language;
        EdKeyword.Text := Word_Name;
      EdTranslation.Text := '';
            if ShowModal <> mrOk then
          Exit;
        end;
        InsertNewWord( Word_Name, ( FfmNewKeyword as TfmNewKeyword ).EdTranslation.Text );
    Result := True;
  finally
        FTranslating := False;
  end;
end;

function TLingua.EditNewLanguage:Boolean;
var
    fmNewLanguage : TfmNewLanguage;
begin
    Result := False;
  fmNewLanguage := TfmNewLanguage.Create( nil );
  TranslateForm( fmNewLanguage );
  try
    with fmNewLanguage do
    begin
      EdLanguage.Text := '';
      if ShowModal = mrOk then
      try
        InsertNewLanguage( EdLanguage.Text );
            Language := EdLanguage.Text;
            Result := True;
      except on E:Exception do
        ShowMessage( E.Message );
      end;
    end;
  finally
    fmNewLanguage.Free;
  end;
end;



constructor TPropertyItem.Create( c : TComponent; pn, pv : string );
begin
    Component := c;
  PropertyName := pn;
  PropertyValue := pv;
end;

procedure TLingua.InsertPropertyCallback( Component : TComponent; PropInfo : PPropInfo );
var
    Value : string;
begin
    if PropInfo^.Name = 'Name' then Exit;
  Value := GetStrProp( Component, PropInfo );
    FListProperties.Add( TPropertyItem.Create( Component, PropInfo^.Name, Value ) );
end;

procedure TLingua.EditUpdateCookie;
var
    i    : Integer;
  Component : TComponent;
  Form : TForm;
  fmUpdateCookie : TfmUpdateCookie;
  item : TPropertyItem;
  mr : Integer;

    procedure InitfmUpdateCookie;
    var
      i : Integer;
    begin
    fmUpdateCookie := TfmUpdateCookie.Create( nil );
    TranslateForm( fmUpdateCookie );
    for i:=0 to FListProperties.Count-1 do
    begin
      item := TPropertyItem(FListProperties[ i ]);
      with TCheckbox.Create( fmUpdateCookie.sbxProperties ) do
      begin
        Parent := fmUpdateCookie.sbxProperties;
        Top := 5+i*20;
        Left := 10;
        Width := 500;
        Caption := item.Component.Name+'.'+item.PropertyName+' = '+item.PropertyValue;
                if     (    (length( item.PropertyValue )>length( Cookie ))
                and (CompareText( Cookie, Copy( item.PropertyValue, 1, length( Cookie ) ))=0) ) then
        begin
            State := cbGrayed;
          Enabled := False;
        end
        else if ((item.PropertyName = 'Caption') or (item.PropertyName = 'Hint'))
               and (Length( item.PropertyValue ) > 0) then
                    State := cbChecked;
      end;
    end;
  end;

    procedure UpdateCookie;
    var
      i : Integer;
  begin
    for i:=0 to fmUpdateCookie.sbxProperties.ComponentCount-1 do
        if (fmUpdateCookie.sbxProperties.Components[ i ] as TCheckbox).State = cbChecked then
        begin
          item := TPropertyItem( FListProperties[i] );
          AddCookie2Property( item.Component, item.PropertyName );
        end;
    end;

begin
    Form := GetParentForm( Self.Owner as TControl );
  if Form = nil then Exit;
    FListProperties := TList.Create;
    try
        CallbackScanProperties := InsertPropertyCallback;
        ScanProperties( Form, [tkString] );

        for i:=0 to Form.ComponentCount-1 do
        if not (Form.Components[ i ] is TLingua) then
              ScanProperties( Form.Components[ i ], [tkString] );

      CallbackScanProperties := nil;
        try
            InitfmUpdateCookie;
      mr := fmUpdateCookie.ShowModal;
      if mr = mrOk then
          UpdateCookie;
    finally
        fmUpdateCookie.Free;
    end;
    finally
         for i:=0 to FListProperties.Count-1 do
        TPropertyItem(FListProperties[ i ]).Free;
    FListProperties.Free;
     end;
    if mr <> mrOk then
      Exit;

    FTest := True;
  try
        Translate;
    ShowMessage( 'Check is ok' );
  finally
        FTest := False;
  end;
end;


{ TDatabaseNameProperty }

type
  TDatabaseNameProperty = class(TStringProperty)
  public
        function GetAttributes: TPropertyAttributes; override;
        procedure GetValues(Proc: TGetStrProc); override;
  end;

function TDatabaseNameProperty.GetAttributes: TPropertyAttributes;
begin
      Result := [paValueList, paSortList, paMultiSelect];
end;

procedure TDatabaseNameProperty.GetValues(Proc: TGetStrProc);
var
      I: Integer;
      Values: TStringList;
begin
      Values := TStringList.Create;
      try
        Session.GetDatabaseNames(Values);
        for I := 0 to Values.Count - 1 do Proc(Values[I]);
      finally
        Values.Free;
      end;
end;

type
  TLanguageProperty = class(TStringProperty)
  public
        function GetAttributes: TPropertyAttributes; override;
        procedure GetValues(Proc: TGetStrProc); override;
  end;

function TLanguageProperty.GetAttributes: TPropertyAttributes;
begin
      Result := [paValueList, paSortList, paMultiSelect];
end;

procedure TLanguageProperty.GetValues(Proc: TGetStrProc);
var
  traductor : TLingua;
    table    : TTable;
begin
    traductor := GetComponent( 0 ) as TLingua;
    table := traductor.TableLangList;
    try
      table.First;
    while not table.Eof do
    begin
        Proc( table.FieldByName( 'Lang_Name' ).asString );
      table.Next;
    end;
    except on E:EDatabaseError do
      ShowMessage( E.Message );
    end;
end;


type
  TCheckProperty = class(TStringProperty)
    public
      procedure Edit; override;
      function GetAttributes:TPropertyAttributes; override;
  end;

procedure TCheckProperty.Edit;
begin
    ( GetComponent(0) as TLingua ).FTest := True;
  try
        ( GetComponent(0) as TLingua ).Translate;
    ShowMessage( 'Check is Ok' );
  finally
        ( GetComponent(0) as TLingua ).FTest := False;
  end;
end;

function TCheckProperty.GetAttributes:TPropertyAttributes;
begin
    Result := [ paDialog ];
end;

type
    TLinguaEditor = class(TComponentEditor)
        function GetVerbCount: Integer; override;
        function GetVerb( Index : Integer ): string; override;
    procedure Edit; override;
    procedure ExecuteVerb( Index : Integer ); override;
  end;

function TLinguaEditor.GetVerbCount : Integer;
begin
    Result := 2;
end;

function TLinguaEditor.GetVerb( Index : Integer ):string;
const
    tab : array[ 0..1 ] of string = ( 'Add language', 'Update cookie' );
begin
    Result := tab[ Index ];
end;

procedure TLinguaEditor.Edit;
begin
    ShowMessage( 'Next version ...' );
end;

procedure TLinguaEditor.ExecuteVerb( Index : Integer );
begin
    case Index of
        0 :    (Component as TLingua).EditNewLanguage;
    1 : (Component as TLingua).EditUpdateCookie;
  end;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TLingua]);
  RegisterPropertyEditor(TypeInfo(TFileName), TLingua, 'DatabaseName', TDatabaseNameProperty);
  RegisterPropertyEditor(TypeInfo(string), TLingua, 'Language', TLanguageProperty);
  RegisterPropertyEditor(TypeInfo(string), TLingua, 'Check', TCheckProperty);
  RegisterComponentEditor( TLingua, TLinguaEditor );
end;

end.